Dist0 = h * Sqr(xs * xs + ys * ys + 1) / (a * xs + b * ys + C)
X0 = x
Y0 = Y
PTria0 = TriaPtr
End If
Distance = Dist0
End Function
Sub DrawWireFrame(Pic As PictureBox)
Dim i As Integer, k As Integer, j As Integer
For k = 1 To UBound(FileVertex)
i = Abs(FileVertex(k).Vert(1))
If i > 0 Then
Xl = to_pix(v(i).x)
Yl = to_pix(v(i).Y)
x1 = Xl
y1 = Yl
For j = 1 To FileVertex(k).Count
i = FileVertex(k).Vert(j)
If i > 0 Then
x = to_pix(v(i).x)
Y = to_pix(v(i).Y)
Pic.Line (x1, y1)-(x, Y)
x1 = x: y1 = Y
End If
Next j
End If
Next
End Sub
Sub Fill_Triangle(Pic As PictureBox, i As Integer)
' // Riempie il triangolo i
Dim Triangle(2) As CornerRec
Dim Anr As Integer
Dim Bnr As Integer
Dim Cnr As Integer
Anr = Triangles(i).Anr
Bnr = Triangles(i).Bnr
Cnr = Triangles(i).Cnr
Triangle(0).x = to_pix(v(Anr).x)
Triangle(0).Y = to_pix(v(Anr).Y)
Triangle(1).x = to_pix(v(Bnr).x)
Triangle(1).Y = to_pix(v(Bnr).Y)
Triangle(2).x = to_pix(v(Cnr).x)
Triangle(2).Y = to_pix(v(Cnr).Y)
Shade% = Triangles(i).PTria.Color
Call DrawTriangle(Pic, Triangle(), Shade%)
End Sub
Sub FindRange(i As Integer)
Dim Normal As Vec3
Normal.x = Triangles(i).PTria.Normal.x
Normal.Y = Triangles(i).PTria.Normal.Y
Normal.Z = Triangles(i).PTria.Normal.Z
Dim rcolor As Single
rcolor = DotProduct(Normal, lightvector)
If (rcolor < rcolormin) Then rcolormin = rcolor
If (rcolor > rcolormax) Then rcolormax = rcolor
End Sub
Function Inside_Triangle(x As Integer, Y As Integer, XA As Integer, YA As Integer, XB As Integer, YB As Integer, xC As Integer, yC As Integer) As Integer
' // (X, Y) giace sopra o dentro il triangolo ABC?
Inside_Triangle = Orientation(XB - XA, YB - YA, x - XA, Y - YA) >= 0 And _
Orientation(xC - XB, yC - YB, x - XB, Y - YB) >= 0 And _
Orientation(XA - xC, YA - yC, x - xC, Y - yC) >= 0
End Function
Function Int_To_Pix(x As Double)
Int_To_Pix = (x + hK) / k
End Function
Function IntersectOrizontal(a As Vec_Int, b As Vec_Int, Y As Integer, xxMin As Integer, xxmax As Integer) As Integer
' // Il segmento AB ha dei punti in comune con il
' // segmento orizzontale {(Xmin, Y), (Xmax, Y)}?
Dim XA As Integer
Dim YA As Integer
Dim XB As Integer
Dim YB As Integer
Dim dx As Long
Dim dy As Long
Dim yDx As Long
XA = a.x
YA = a.Y
XB = b.x
YB = b.Y
If (YA < Y And YB < Y Or YA > Y And YB > Y) Then
IntersectOrizontal = 0
Exit Function
End If
If (YA = Y And XA >= xxMin And XA <= xxmax Or _
YB = Y And XB >= xxMin And XB <= xxmax) Then
IntersectOrizontal = 1
Exit Function
End If
If (YA = YB) Then
IntersectOrizontal = YA = Y And (CLng(XA - xxmax) * (XB - xxmax) < 0 Or CLng(XA - xxMin) * (XB - xxMin) < 0)
Exit Function
End If
If (YA > YB) Then
Swap XA, XB
Swap YA, YB
End If
dx = XB - XA
dy = YB - YA
XdY = XA * dy + (Y - YA) * dx
IntersectOrizontal = XdY >= xmin * dy And XdY <= xmax * dy
End Function
Function IntersectVertical(a As Vec_Int, b As Vec_Int, x As Integer, yyMin As Integer, yymax As Integer) As Integer
' // Il segmento AB ha dei punti in comune con il
' // segmento verticale {(X, Ymin), (X, Ymax)}?
Dim XA As Integer
Dim YA As Integer
Dim XB As Integer
Dim YB As Integer
Dim dx As Long
Dim dy As Long
Dim yDx As Long
XA = a.x
YA = a.Y
XB = b.x
YB = b.Y
If (XA < x And XB < x Or XA > x And XB > x) Then
IntersectVertical = 0
Exit Function
End If
If (XA = x And YA >= yyMin And YA <= yymax Or _
XB = x And YB >= yyMin And YB <= yymax) Then
IntersectVertical = 1
Exit Function
End If
If (XA = XB) Then
IntersectVertical = XA = x And (CLng(YA - yymax) * (YB - yymax) < 0 Or CLng(YA - yyMin) * (YB - yyMin) < 0)
Function Orientation(u1 As Integer, U2 As Integer, v1 As Integer, v2 As Integer) As Long
Dim Det As Long
Det = CLng(u1) * v2 - CLng(U2) * v1
If Det < -250 Then
Det = -1
ElseIf Det > 250 Then
Det = 1
End If
Orientation = Det
End Function
Sub Q_Sort(a() As Tria, Ptr As Integer, n As Integer)
' Quick Sort
' a = Triangles()
' Ptr = Puntatore ad a()
' n = Num. elemento corrente per il sort
Dim i As Integer, j As Integer
Dim x As Tria
Dim w As Tria
Do
i = Ptr
j = n - 1
x = a(j / 2)
Do
Do While (a(i).Z < x.Z): i = i + 1: Loop
Do While (a(j).Z > x.Z): j = j - 1: Loop
If (i < j) Then
w = a(i)
a(i) = a(j)
a(j) = w
End If
i = i + 1
j = j - 1
Loop While i <= j
If i = j + 3 Then
i = i - 1
j = j + 1
End If
If j + 1 < n - i Then
If j > 0 Then Q_Sort a(), 0, j + 1
' Ptr = Ptr + i
n = n - i
Else
Pt% = i
If i < n - 1 Then Q_Sort a(), Pt%, n - i
n = j + 1
End If
Loop While n > 1
End Sub
Sub Set_Tr_Color(i As Integer)
Dim Color As Integer
Dim rcolor As Double
Dim Normal As Vec3
Normal.x = Triangles(i).PTria.Normal.x
Normal.Y = Triangles(i).PTria.Normal.Y
Normal.Z = Triangles(i).PTria.Normal.Z
rcolor = DotProduct(Normal, lightvector)
Color = 1 + (rcolor - rcolormin) * delta
If (Color < 0) Then MsgBox ("Codice colore negativo")
If (Color >= 16) Then MsgBox ("Codice colore troppo grande")
' // (in caso di un errore di programma)
Triangles(i).PTria.Color = Color
' MsgBox Color
End Sub
Sub SetLimitiVista(xsmin As Double, xsmax As Double, ysmin As Double, ysmax As Double, nvertex As Integer, Vt() As Vec3)
Dim PNew As Vec3
Dim Ve As Vec3
Dim Vi As Vec3
Dim Va As Vec3
Dim i As Integer
Dim k As Integer
For i = 0 To nvertex
Vt(i).Z = -1000000# ' Non usato
Next
xsmin = BIG
ysmin = BIG
zemin = BIG
xsmax = -BIG
ysmax = -BIG
zemax = -BIG
For k = 1 To UBound(FileCoord)
i = FileCoord(k).i
Vi.x = FileCoord(k).x
Vi.Y = FileCoord(k).Y
Vi.Z = FileCoord(k).Z
If i > 0 Then
If (i >= nvertex) Then
MsgBox "Troppi vertici o numero di vertice non legale"
End
End If
PNew.x = Vi.x - ObjPoint.x
PNew.Y = Vi.Y - ObjPoint.Y
PNew.Z = Vi.Z - ObjPoint.Z
Call Eyecoord(PNew, Ve)
Va.x = Ve.x
Va.Y = Ve.Y
Va.Z = Ve.Z
If (Va.Z < 0) Then
MsgBox "Il punto 0 dell'oggetto e un vertice " & Chr(10) & "su lati diversi del punto di osservazione E." & Chr(10) & "Provare con un valore maggiore per rho."
Exit Sub
End If
xs = Va.x / Va.Z
ys = Va.Y / Va.Z
If (xs < xsmin) Then xsmin = xs
If (xs > xsmax) Then xsmax = xs
If (ys < ysmin) Then ysmin = ys
If (ys > ysmax) Then ysmax = ys
If (Va.Z < zemin) Then zemin = Va.Z
If (Va.Z > zemax) Then zemax = Va.Z
Vt(i) = Ve
End If
Next k
If (xsmin = BIG) Then
MsgBox "File di input non corretto"
End
End If
End Sub
Sub SetVista(rho As Double, Theta As Double, Phi As Double)
